#!/usr/bin/perl -w

package C_client2;

use strict;
use Sys::Hostname;
use English;
use Socket;
use IO::Socket::INET;
use Digest::SHA1 qw(sha1 sha1_hex);
use Crypt::Blowfish;
use Crypt::CBC;
use Data::Dumper;
use Net::Ping;
use Carp qw(cluck confess);

#########################################################################
# Optionally get hold of Crypt::RSA for PKI support.			#
#########################################################################

BEGIN {
	if(!exists($::ENV{TRUECL_CFG})) {
		die("Missing environment variable TRUECL_CFG.");
	}
	$C_client2::PKI=1;
	eval 'use Crypt::RSA;';
	if($@) {
		$C_client2::PKI=0;
		print "DEBUG: Crypt::RSA failed to load: $@\n" if $::DEBUG;
	}
}

sub _dprint(@) {
	return if ! $::DEBUG;
	print STDERR "DEBUG: ",@_;
}

if($C_client2::PKI==1 && exists($::ENV{TRUECL_PKI})) {
	$C_client2::PKI=$::ENV{TRUECL_PKI};
}

_dprint "PKI value for session set to: $C_client2::PKI\n";

#########################################################################
# The new method for a communication with the server...			#
# SERVER_NAME can be BROADCAST if the idea is to broadcast to all	#
# servers rather than communicate with a specific one.			#
# If PKI is being used the keys in question are expected to exist	#
# under the directory TRUECL_CFG/pki. Otherwise the normal client	#
# keys are expected to be found under TRUECL_CFG/keys			#
#########################################################################

my $error=undef;

sub error_str {
	return $error;
}

sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
my %args=@_;

	$error=undef;
	die("Missing TRUECL_CFG environment variable") if !exists($::ENV{TRUECL_CFG});
	die("SERVER_INET is not specified.") if !exists($args{SERVER_INET});
	die("SERVER_PORT is not specified.") if !exists($args{SERVER_PORT});

	$self->{SERVER_NAME} = $args{SERVER_NAME};	# Name address to use 		 #
	$self->{SERVER_INET} = $args{SERVER_INET};	# Inet address to use 		 #
	$self->{SERVER_PORT} = $args{SERVER_PORT};	# Port number to use		 #

	if(exists($args{PKI}) && $args{PKI}) {
		confess("Local host does not support PKI.") if ! $C_client2::PKI;
		confess("SERVER_NAME is not specified.") if !exists($args{SERVER_NAME});
		$self->{PKI}=1;
		#########################################################################
		# For PKI to work we need teh following:				#
		# 1. Public key of server						#
		# 2. Private key to decrypt response					#
		# The server will require:						#
		# 1. Private key to decrypt request					#
		# 2. Public key of client to send request				#
		#########################################################################
		my $d="$::ENV{TRUECL_CFG}/pki";
		my $s=$args{SERVER_NAME};
		my $h=hostname;

		if(! -e "$d/$s.public") {
			$error="Missing Server public key: $d/$s.public.";
			return undef;
		}
		_dprint "Found public key: $d/$s.public\n";
		my $public=new Crypt::RSA::Key::Public(Filename => "$d/$s.public");
		if(!defined($public)) {
			$error="Unable to load Public key for Server $s!";
			_dprint "Failed to load public key!\n";
			return undef;
		}
		_dprint "Loaded public key for server: $d/$s.public\n";
		if(! -e "$d/$h.private") {
			$error="Missing Local private key: $d/$h.private.";
			_dprint "Missing Local private key: $d/$h.private.\n";
			return undef;
		}
		my $private=new Crypt::RSA::Key::Private(Filename => "$d/$h.private");
		if(!defined($private)) {
			$error="Unable to load Private key for localhost!";
			_dprint "Unable to load Private key for localhost!\n";
			return undef;
		}
		_dprint "Loaded private key for localhost: $d/$h.private\n";
		$self->{PKI_RSA}=new Crypt::RSA;
		$self->{PKI_SERVER_PUBLIC}=$public;
		$self->{PKI_CLIENT_PRIVATE}=$private;
	} else {
		$self->{PKI}=0;
		if(!exists($args{CLIENT_KEY})) {
			my $d="$::ENV{TRUECL_CFG}/keys";
			my $h=hostname;

			if(! -e "$d/$h.key") {
				$error="Missing Client key file: $d/$h.key.";
				_dprint "Missing Client key file: $d/$h.key.\n";
				return undef;
			}
			_dprint "Found client key: $d/$h.key.\n";
			if(! -f "$d/$h.key") {
				$error="Client key file is actually a directory: $d/$h.key.";
				_dprint "Client key file is actually a directory: $d/$h.key.\n";
				return undef;
			}
			my ($fd,$key,$window);
			if(!open($fd,"$d/$h.key")) {
				$error="Unable to read from Client key file: $d/$h.key.";
				return undef;
			}
			$key=<$fd>;
			if(!defined($key)) {
				$error="Client key file not in expected format (missing key): $d/$h.key.";
				_dprint "Client key file not in expected format (missing key): $d/$h.key.\n";
				return undef;
			}
			$window=<$fd>;
			if(!defined($window)) {
				$error="Client key file not in expected format (missing window): $d/$h.key.";
				_dprint "Client key file not in expected format (missing window): $d/$h.key.\n";
				return undef;
			}
			close($fd);
			chomp $key;
			chomp $window;
			_dprint "Loaded key   : $key\n";
			_dprint "Loaded window: $window\n";

			$self->{CLIENT_KEY}  = $key;
			$self->{WINDOW}	     = int($window);
		} else {
			$self->{CLIENT_KEY}  = $args{CLIENT_KEY};
			$self->{WINDOW}	     = 127;     # Allows 127 out (at least)	 #
			_dprint "ARGV key         : $self->{CLIENT_KEY}\n";
			_dprint "Hard coded window: $self->{WINDOW}\n";
		}
	}

	$self->{CLIENT_NAME} = hostname;	# Identify ourselves via hostname#
	$self->{TIMEOUT}     = 4;       	# Default timeout of 4 seconds	 #
	$self->{PING}=Net::Ping->new("icmp") if $<==0;
	bless($self,$class);
	return $self;
}

sub set_params {
my $self=shift;
my %args=@_;

	#########################################################################
	# WINDOW is used for random key generation - so not used if PKI		#
	# client type has been requested.					#
	#########################################################################
	if(exists($args{WINDOW})) {
		$self->{WINDOW}=$args{WINDOW};
		delete $args{WINDOW};
	}
	if(exists($args{TIMEOUT})) {
		$self->{TIMEOUT}=$args{TIMEOUT};
		delete $args{TIMEOUT};
	}
	if(scalar(keys(%args))) {
		return 0;
	}
	return 1;
}


#########################################################################
# This subroutine will send an encrypted message to the specified	#
# server in the following format:					#
#									#
# SENDER|MSG|SHA1							#
#									#
# The actual MSG|SHA1 is in the format HEX|HEXSHA1, where HEX is	#
# encrypted using the CLIENT_KEY and time&~WINDOW.			#
#									#
# Optional parameter should be set to 0 or 1 .. sendonly - no response	#
# is expected - simply close connection - typically used for broadcast	#
# messages.								#
#									#
# In such cases the message is sent in the WINDOW format since the	#
# destination host will not be a single host.				#
#									#
# It will wait for the response from the client - higher level		#
# routines should perform any time-out operations.			#
# Arguments: msg	- the message to send.				#
#									#
# Returns(response,undef) - valid response from server.			#
# 	 (undef,msg)      - an error has occured.			#
#########################################################################

sub send_request {
my $self=shift;
my $msg=shift;
my $sendonly=shift;

$sendonly=0 if !defined($sendonly);
my $timeout;
my $cipher;
my $sha1_sum;
my $sha1_sum2;
my $enc_data;
my $port;
my $host;
my $key;
my $socket_fd;
my $junk;
my $newkey;
my $type;

	_dprint "Entered send_request (sendonly=$sendonly)\n";
	if(!defined($msg)) {
		_dprint "Exiting - messag to send to server is blank.\n";
		return(undef,"Message to send server is blank!");
	}
	$timeout=$self->{TIMEOUT};
	if($self->{PKI}==0) {
		$key=$self->{CLIENT_KEY};
		my $window=int($self->{WINDOW});
		my $time=time;
		_dprint "Current time   : $time\n";
		$time&= ~$window;
		_dprint "Windowed time  : $time\n";
		$sha1_sum=sha1_hex("$msg");
		_dprint "SHA1 sum of msg: $sha1_sum\n";

	#################################################################
	# Now we have the sha1 sum of the message encrypt the actual	#
	# data of interest.						#
	#################################################################

		$key="$key+$time";
		_dprint "Sending request using Key=$key\n";
		$cipher=new Crypt::CBC($key,"Blowfish");
		$enc_data=$cipher->encrypt_hex($msg);
		eval {$enc_data=$cipher->encrypt_hex($msg);};
		if(!defined($enc_data)) {
			_dprint "Failed to encode msg '$msg'.\n";
			return(undef,"Failed to encode msg '$msg'.");
		}
		$enc_data="$self->{CLIENT_NAME}|$enc_data|$sha1_sum";
	} else {
		#########################################################
		# Here enc_data is in the form:				#
		# client_name|RSA|enc_data				#
		#########################################################
		$enc_data="$self->{CLIENT_NAME}|RSA|";
		my $d=$self->{PKI_RSA}->encrypt(Message => $msg, Armour => 0,Key => $self->{PKI_SERVER_PUBLIC});
		if(!defined($d)) {
			return(undef,"Unable to encrypt message type RSA to $self->{SERVER_NAME}.");
		}
		$enc_data.=unpack("H*",$d);
	}
	$port=$self->{SERVER_PORT};
	$host=$self->{SERVER_INET};
	_dprint "Encoded packet successfully";

	#################################################################
	# host might be a comma-separated list of IP addresses, and if	#
	# so we double check with a ping the last one we used - if	#
	# available, and if it fails, try the others...			#
	#################################################################
	# If running in send only the timeout and ping checks are 	#
	# reduced, though we still attempt a ping to ensure all 	#
	# possible routes are checked.					#
	#################################################################

GET_IP:	{
		my $okk=0;
		if($< != 0) {
			if(!exists($self->{LAST_IP})) {
				if(index($host,",")==-1) {
					$self->{LAST_IP}=$host;
					last GET_IP;
				} else {
					my @L=split(/,/,$host);
					$self->{LAST_IP}=$L[0];
				}
				print "MESG: Defaulted LAST_IP to $self->{LAST_IP} [non root user!]" if $::DEBUG;
			}
		} else {
			my $ping_timeout=0.25;
			my $ping_increment=0.25;
			if($sendonly) {
				$ping_timeout=0.1;
				$ping_increment=0.1;
				$timeout=1;
			}
			if(exists($self->{LAST_IP}) && defined($self->{LAST_IP})) {
				if($self->{PING}->ping($self->{LAST_IP},$ping_timeout)) {
					print "MESG: LAST_IP validated to address $self->{LAST_IP}\n" if $::DEBUG;
					$okk=1;
				}
			}
			#################################################################
			# If okk==0 then it means that the no connection, of no		#
			# initial IP, so attempt a connection.				#
			#################################################################
			if(! $okk && index($host,",")>-1) {
				print "MESG: Multiple IP address && LAST_IP must be determined!\n" if $::DEBUG;
				my @L=split(/,/,$host);
				my $total=0;
				my $maxt=$ping_timeout;
				my $cip;
				while(1) {
					print "MESG: Total time spent looking for ip=$total\n" if $::DEBUG;
					for $cip (@L) {
						next if $cip eq "" || $cip =~ /^\s+$/;
						print "MESG: Attempting to ping '$cip' [timeout=$maxt]\n" if $::DEBUG;
						if($self->{PING}->ping($cip,$maxt)) {
							$self->{LAST_IP}=$cip;
							$okk=1;
							last;
						}
						$total+=$maxt;
						if($total>=$timeout) {
							return (undef,"CONNECT ERROR: Unable to connect to server[1]");
						}
					}
					if(!$okk) {
						if($total>=$timeout) {
							return (undef,"CONNECT ERROR: Unable to connect to server[2]");
						}
					}
					last if $okk;
					$maxt+=$ping_increment;	# try again, but longer timeout
				}
			} else {
				if($okk==0) {
					if($sendonly) {
						$self->{LAST_IP}=$host;
						last GET_IP;
					}
					print "MESG: Single IP only [$host] - checking ping.\n" if $::DEBUG;
					my $cip=$host;
					my $total=0;
					my $maxt=$ping_timeout;
					while(1) {
						print "MESG: Attempting ping of $cip [$maxt]\n" if $::DEBUG;
						if($self->{PING}->ping($cip,$maxt)) {
							$self->{LAST_IP}=$cip;
							$okk=1;
							last;
						}
						$total+=$ping_timeout;
						if(!$okk) {
							if($total>$timeout) {
								return (undef,"CONNECT ERROR: Unable to connect to server[3]");
							}
						}
						last if $okk;
						$maxt+=$ping_increment;	# try again, but longer timeout
					}
				}
			}
		}
	}

	print "MESG: Defined LAST_IP as $self->{LAST_IP}\n" if $::DEBUG;
	#################################################################
	# Now we have the message to send, and the port details we can	#
	# create a TCP socket to the destination, and send the 		#
	# message.							#
	#################################################################

	print "MESG: Attempting socket connection to $host:$port [timeout=$timeout]\n" if $::DEBUG;
	print "MESG: [IP address for connection is $self->{LAST_IP}]\n" if $::DEBUG;
	$socket_fd=IO::Socket::INET->new(
                PeerAddr => $self->{LAST_IP},
                PeerPort => $port,
                Type     => SOCK_STREAM,
                Timeout  => $timeout);
	if(! defined $socket_fd) {
		return (undef,"CONNECT ERROR: Unable to connect to server[4] - $!");
	}

	#################################################################
	# Now we have actually connected to the remote socket we send 	#
	# our message across....					#
	# So we turn on output flushing for this handle...		#
	#################################################################

	my $new_fd=select($socket_fd);
	$|= 1;
	select($new_fd);
	print "MESG : Sending request '$enc_data'\n" if $::DEBUG;
	print $socket_fd "$enc_data\n";

	#################################################################
	# If in sendonly mode close the socket and return immediately.	#
	#################################################################

	if($sendonly) {
		close($socket_fd);
		# shutdown($socket_fd,2);
		return("OK",undef);
	}

	#################################################################
	# Set up the bit vectors for the response.			#
	#################################################################

	my ($rout,$rin,$win,$ein,$nfound);
	$rin = $win = $ein = '';
	vec($rin,fileno($socket_fd),1) = 1;
	$ein = $rin | $win;
	
	$rout='';
	$nfound=select($rout=$rin, undef, undef, $timeout);
	if(!$nfound || !vec($rout, fileno($socket_fd), 1)) {
		close $socket_fd;
		return (undef,"TIMEOUT ERROR: No response in specified timeout.");
	}

	my $server_response=<$socket_fd>;
	if(! defined $server_response) {
		close $socket_fd;
		return (undef,"Server closed connection without a response!");
	}
	close $socket_fd;
	chomp $server_response;

	#################################################################
	# The reponse returned is in the following format:		#
	# R|HEX|SHA1							#
	# HEX is hex_encrypted response and SHA1 is sum of unencrypted	#
	# reponse.							#
	# Alternatively if the response is RSA PKI then it will be in	#
	# the following format:						#
	# R|HEX|RSA							#
	# Where "RSA" is actually the text "RSA".			#
	#								#
	# If an errors has occured, the response is in the format:	#
	# E|HEX|SHA1							#
	# In this instance it is just uncrypted hex which can be 	#
	# passed back to the client.					#
	#################################################################

	($type,$enc_data,$sha1_sum)=split(/\|/,$server_response);
	print STDERR "type=$type,enc_data=$enc_data,sha1_sum=$sha1_sum\n" if $::DEBUG;
	if(!defined($type) || !defined($enc_data) || !defined($sha1_sum)) {
		return(undef,"PROTOCOL ERROR: Server response not in expected format.");
	}
	if($type eq "E") {
		return(undef,"PROTOCOL ERROR: ".pack("H*",$enc_data));
	}

	if($type ne "R") {
		return(undef,"PROTOCOL ERROR: Server reponses type not R or E.");
	}

	#################################################################
	# So reponse is in R|hex|sha1					#
	# or R|hex|RSA							#
	#################################################################

	if($sha1_sum eq "RSA") {
		if($self->{PKI}==0) {
			return(undef,"PROTOCOL ERROR: Sent Key/window message - got RSA type response!");
		}
		my $data=$self->{PKI_RSA}->decrypt(Ciphertext => pack("H*",$enc_data),Armour => 0,Key =>$self->{PKI_CLIENT_PRIVATE});
		if(!defined($data)) {
			return(undef,"PROTOCOL ERROR: Decryption of response from $self->{SERVER_NAME} failed.");
		}
		return($data,undef);
	}

	#################################################################
	# Deal with random shifting password stuff now.			#
	#################################################################
	my $data=$cipher->decrypt_hex($enc_data);
	print STDERR "Decrypted to: $data\n" if $::DEBUG;
	$sha1_sum2=sha1_hex($data);
	if($sha1_sum ne $sha1_sum2) {
		return(undef,"PROTOCOL ERROR: Corrupt or invalid data found.");
	}
	
	return($data,undef);
}

1;

__END__

=head1 NAME

C_client2 - client side library for encrypted sockets (V2)

=head1 SYNOPSIS

    # Standard key/window encryption usage

    use C_client2;
    $channel=new C_client2(	PKI         => 0,
				SERVER_NAME => "fred",
				SERVER_INET => "192.122.12.2",
				SERVER_PORT => 888);
    if(defined $channel) {
            for $msg ("mess1","mess2") {
                ($response,$error)=$channel->send_request($msg);
                if(! defined $error) {
                    print "Response: $response\n";
                } else {
	            print "Error   : $error\n";
	        }
	    }
        }
    }

    # PKI Usage - same, but set PKI = 1

=head1 DESCRIPTION

The C_client2 package implements the client side functionality of the
encrypted sockets utilities, allowing secure client/server communication 
over sockets, making use of a choice of two encrypted protocols.

One choice the key/window protocol is the fastest (smaller packets, less
CPU overhead), but is less secure. The alternative is a RSA-based Public-Private
Key-based encryption that is more secure, at the cost of data volume and
CPU overhead.

No timeout support is currently offered - it is expected that higher
level protocols will provide such features.

=head1 Supported Methods

=over 4

=item B<new>

This is based parameters as a hash, with the following keys currently
being supported:

=over 4

=item B<PKI>

This indicates whether or not to use RSA-based public/private key
encryption or the key/window encryption. Set this value to 1 for
RSA-based encryption of 0 for key/window encryption.

=item B<SERVER_NAME>

The name of the remote server to communicate with - this is required for
both protocols, but only really matters for the RSA-based encryption.

=item B<SERVER_INET>

The IP address to communicate with to connect to the remote server.
This can be a comma separated list of addresses one of which
will hopefully get through to the server.

=item B<SERVER_PORT>

The Port address to communicate on with the remote server.

=item N<CLIENT_KEY>

Optional parameter used to set the client value. If not specified
it is expected to load the necessary key from a local file (see below).

=item B<set_params(args)>

The B<set_params> allows the WINDOW and TIMEOUT parameters for the 
object to be changed. The TIMEOUT affects the establishment of the 
Socket as well as then length of time waiting for a client response.

The default for the TIMEOUT is 2, whilst the default for the WINDOW
is 63. The WINDOW should be 31, 63, 127 or 255. Shorter windows are
more secure but require the time difference on the servers to be less
than WINDOW seconds to be reliable.

The WINDOW parameter only has an affect when using key/window
based encryption and both the client and server must be set to the
same window.

=item B<msg_send(msg,[sendonly])>

The B<msg_send> allows a specified message to be send over the
channel. It will return a result specified as a list of two values.

The two values returned by this method are used as follows:

=over 4

=item B<response>

A text response decrypted from the server - this means that the 
commands has been recieved and acted on by the server.

=item B<errormsg>

If there was a problem with the communication than this will be set. 
If everything went OK it will be undefined.

If the B<sendonly> argument is present and set to 1 it will only
send out the packet and then close the socket not waiting for
a connection. This is used for broadcasting packets. 

=back

=head1 KEYS

When performing RSA-based public/private key encryption all keys are
expected to exist in the the following directory:

=over 4
$TRUECL_CFG/pki

=back

In such cases the names of the keys will be hostname.public or
hostname.private.

When using key/window based encryption the key for the client
is expected to be found in the directory:

=over 4

$TRUECL_CFG/keys

=back

The format of the files in this directory will be hostname.key.
The contents will be two lines - one for the key and one for the
window.

=head1 BUGS

The interface is purposely limited to aims to be as simple as possible.
This is not considered a 'bug'.

=head1 AUTHOR

Simon Edwards       simon.edwardS@linuxha.net

When using the key/window encryption, the following modukes
are required:

=over 4

=item *

Crpyt::Blowfish

=item *

Crypt::CBC

=item *

Digest::SHA1

=back

Support for Crypt::RSA requires significantly more!

=cut
